00100	C **********  MATRIX  FEB. 16,73 ******** PRINTS 12-TONE CHART ******
00200	C  'S'EARCH WILL LOCATE ROW SOURCES OF CHORDS, ETC.
00300		DIMENSION INV(12),IR(12),N(12),J(13,13),ISCAL(12),IS2(12),
00400		1 INP2(72),INP(72)
00500		1,IC(6),ISQ(25,25),NAME(10),INOT(49),JA(12)
00600		DATA ISCAL/'C','C#','D','D#','E','F','F#','G','G#',
00700		1 'A','A#','B'/,INV/'I1','I2','I3','I4','I5','I6','I7',
00800		1 'I8','I9','I10','I11','I12'/,IR/'R1','R2','R3','R4',
00900		1 'R5','R6','R7','R8','R9','R10','R11','R12'/
01000	CC	1 'R5','R6','R7','R8','R9','R10','R11','R12'/,IV/-1/
01100		DATA IS2/'C','$','D','$','E','F','$','G','$','A','$','B'/
01200	662	TYPE 61
01300		ACCEPT 1,NRW
01400		IF(NRW.EQ.'P')GO TO 62
01500		IF(NRW.EQ.'T')GO TO 1188
01600		IF(NRW.NE.'S')GO TO 64
01700	663	TYPE 65
01800		GO TO 661
01900	65	FORMAT(' TYPE NOTES'/)
02000	61	FORMAT(' NEW ROW, TYPE, PRINT OR SEARCH?'/)
02100	300	FORMAT(' PRINT HOW MANY?'/)
02200	200	FORMAT(' TYPE NAME'/)
02300	62	KREP=0
02400	CC	IF(IV)GO TO 1188
02500		TYPE 300
02600		ACCEPT 400,KREP
02700	1188	KREP=KREP-1
02800	CC	IV=0
02900		JOUT=3
03000		IF(NRW.EQ.'T')JOUT=5
03100		GO TO 288
03200	64	HEX=-10
03300	  	TYPE 200
03400		J(2,1)=INV(1)
03500		J(1,2)=IR(1)
03600	  	ACCEPT 444,NAME
03700	188	TYPE 100
03800	661	JOUT=5
03900	CC	PRINT=0
04000	CC	NOPRIN=-1
04100		FIRST=-1.
04200	  	ACCEPT 1,INP2
04300	CC	IF(INP(1).NE.'S')GO TO 198
04400		IF(NRW.EQ.'S')GO TO 498
04500		DO 665 KGZ=1,72
04600	665	INP(KGZ)=INP2(KGZ)
04700		GO TO 198
04800	CC	IF(INP(2).EQ.'P')PRINT=-1.
04900	CC664	IF(NRW.EQ.'P')PRINT=-1.
05000	C   IF A 13TH NOTE IS ADDED, THEN NO PRINTOUT.
05100	C   TYPE 'S' TO SEARCH, 'SP' OUTPUTS TO LPT.
05200	CC498	K=2
05300	498	K=0
05400		JS=0
05500		ISQ2=0
05600	CC	IF(PRINT.EQ.0)GO TO 298
05700	CC	WRITE(JOUT, 60)
05800	CC	WRITE(JOUT, 60),NAME
05900	CC	WRITE(JOUT, 60)
06000	CC	WRITE(JOUT, 1),K,(INP(LL),LL=1,71)
06100	298	K=K+1
06200		DID=0
06300		IF(K.GT.72)GO TO 8888
06400		L=INP2(K)
06500		IF(L.EQ.' ')GO TO 298
06600		DO 888 M=1,12
06700		  IF(L.NE.IS2(M))GO TO 888
06800		  LL=M
06900		  K=K+1
07000		  IF(INP2(K).EQ.'S')LL=M+1
07100		  IF(INP2(K).EQ.'F')LL=M-1
07200		  ISQ2=ISQ2+2**LL
07300	C   ASSIGNS # TO EACH NOTE
07400		  JS=JS+1
07500	C   JS IS # OF NOTES IN GROUP TO BE FOUND.
07600		  GO TO 298
07700	888	CONTINUE
07800	8888	IF(JS.EQ.0)CALL EXIT
07900	C   NO NOTES WERE GIVEN.
08000		IF(FIRST)LGRP=JS
08100		FIRST=0
08200	C  SAVE # OF NOTES TO BE FOUND.
08300		JGRP=JS-1
08400		DO 333 NN=1,2
08500	CC	  DO 333 K=2,13
08600		  DO 333 K=1,13
08700	C   '+JGRP' IS FOR WRAP-AROUND
08800		  JQ=2
08900	  	    DO 222 L=1,12
09000		    KQ=L
09100	C   SETS # OF 1ST NOTE OF FOUND GROUP.
09200		    LL=0
09300		      DO 223 KK=JQ,JQ+JGRP
09400		      NR=KK
09500		      NI=K
09600		      IF(NN.EQ.1)GO TO 223
09700		      NR=K
09800		      NI=KK
09900	223	      LL=LL+ISQ(NR,NI)
10000	2223	    IF(LL.EQ.ISQ2)GO TO 334
10100	222	    JQ=JQ+1
10200		  GO TO 333
10300	334	  NR=1
10400		IF(LGRP.NE.JS)TYPE 67,JS  
10500		LGRP=JS
10600	C   NN=1, R FORMS.   NN=2, I FORMS.
10700		  IF(NN.EQ.1)GO TO 2334
10800		  NI=1
10900		  NR=K
11000	C   K WILL BE 1ST NOTE OF GROUP IN ROW.
11100	2334	  WRITE(JOUT, 66),J(NR,NI),KQ
11200		DID=-1.
11300	333	CONTINUE
11400		IF(DID)GO TO 3333
11500	CC	IF(JGRP.EQ.1)GO TO 188
11600		IF(JGRP.NE.1)GO TO 3334
11700	C  DON'T TRY AGAIN IF GROUP IS DOWN TO 2.
11800		TYPE 67,JGRP
11900		GO TO 3333
12000	3334	DO 398 K=72,1,-1
12100		  IF(INP2(K).EQ.' ')GO TO 398
12200	3398	  INP2(K)=' '
12300		  INP2(K-1)=' '
12400		  GO TO 498
12500	398	CONTINUE
12600	C  ABOVE SHORTENS GROUP BY ONE.
12700	3333	TYPE 60
12800		GO TO 662
12900	198  	JJ=1
13000		K=0
13100	98	K=K+1
13200		IF(K.GT.72)GO TO 9999
13300		L=INP(K)
13400		IF(L.EQ.' ')GO TO 98
13500		IF(JJ.EQ.14)GO TO 99
13600	C   ANYTHING TYPED AFTER 12 NOTES CAUSES 'NOPRIN'.
13700		DO 999 M=1,12
13800		  IF(L.NE.IS2(M))GO TO 999
13900		  LL=M
14000		  K=K+1
14100		  IF(INP(K).EQ.'S')LL=M+1
14200		  IF(INP(K).EQ.'F')LL=M-1
14300		  JA(JJ)=LL
14400	C   SAVES #S FOR NOTATION
14500		  JJ=JJ+1
14600		  J(JJ,2)=LL
14700		  ISQ(JJ,2)=2**LL
14800	C   SETS VALUE AS POWER OF 2 FOR EACH NOTE.
14900		  GO TO 98
15000	999	CONTINUE
15100	CC99	NOPRIN=-1
15200	99	CONTINUE
15300	
15400	9999	IF(JJ.EQ.1)CALL EXIT
15500	C   NO NOTES WERE GIVEN.
15600	    	I=J(2,2)
15700	C   WORKS OUT MATRIX
15800		DO 9 K=3,13
15900		  LL=J(K,2)-I+1
16000		  IF(LL.LE.0)LL=LL+12
16100	9	J(K,1)=INV(LL)
16200		DO 2 K=2,12
16300	2	N(K)=J(K+1,2)-I
16400		DO 3 K=3,13
16500		  LL=I-N(K-1)
16600		  IF(LL.LT.1)LL=LL+12
16700		  IF(LL.GT.12)LL=LL-12
16800		  ISQ(2,K)=2**LL
16900		  J(2,K)=LL
17000		  LL=LL+1-I
17100		  IF(LL.LE.0)LL=LL+12
17200	3	J(1,K)=IR(LL)
17300		DO 4 K=3,13
17400		  DO 4 I=3,13
17500		    LL=J(2,I)+N(K-1)
17600		    IF(LL.LT.1)LL=LL+12
17700		    IF(LL.GT.12)LL=LL-12
17800		    ISQ(K,I)=2**LL
17900	4	J(K,I)=ISCAL(LL)
18000		DO 7 K=2,13
18100	7	J(K,2)=ISCAL(J(K,2))
18200		DO 8 K=3,13
18300	8	J(2,K)=ISCAL(J(2,K))
18400	10	J(1,1)=0
18500		DO 28 K=2,13
18600		  DO 28 L=2,13
18700		    KQ=ISQ(K,L)
18800		    ISQ(K+12,L)=KQ
18900	28	ISQ(K,L+12)=KQ
19000	C   +12 FOR WRAP-AROUND
19100	CC288	IF(NOPRIN)GO TO 111
19200	288	WRITE(JOUT, 60),NAME
19300		WRITE(JOUT, 60)
19400	C  NEXT JUMPS OVER NOTATION PRINT.
19500		GO TO 5557
19600	C  UNTIL 210, PRINTS NOTATION
19700		G=' '
19800		WRITE(JOUT, 201),G
19900		L=5
20000		DO 202 IJ=1,7
20100		  LN=-1
20200		  IF(IJ.EQ.2.OR.IJ.EQ.4.OR.IJ.EQ.6)LN=0
20300	C   LINE OR SPACE
20400		JK=2
20500		IF(IJ.EQ.1.OR.IJ.EQ.4)JK=1
20600		  DO 203 IQ=1,JK
20700	204	    DO 205 K=1,49
20800	205	    INOT(K)=' '
20900		    DO 206 K=1,12
21000		      IF(JA(K).NE.L)GO TO 206
21100	C  SKIPS IF NO NOTE  NOW
21200		      IK=K
21300		      L=L-1
21400		      IF(L.EQ.0)L=12
21500		      M=K*4-1
21600		      IF(IK.GT.6)M=M+2
21700	2000	      INOT(M)='O'
21800		      IF(L.EQ.3.OR.L.EQ.1.OR.L.EQ.10.OR.L.EQ.8.OR.
21900		1     L.EQ.6)INOT(M-1)='#'
22000		      IF(L.EQ.2.OR.L.EQ.12.OR.L.EQ.9.OR.L.EQ.7.OR.
22100		1     L.EQ.5)LN=0
22200		      GO TO 208
22300	206	    CONTINUE
22400	208	    IF(LN)WRITE(JOUT, 209),(INOT(IZ),IZ=1,M)
22500	C   OVERPRINTS
22600	203	    IF(LN.EQ.0)WRITE(JOUT, 210),(INOT(IZ),IZ=1,M)
22700		  G=' '
22800		  IF(IJ.EQ.5)G='G'
22900	202	  IF(IJ.NE.2.AND.IJ.NE.4.AND.IJ.NE.6)WRITE(JOUT, 201),G
23000	201	FORMAT(2XA1,52('-'))
23100	209	FORMAT(4X49A1)
23200	210	FORMAT('+',4X49A1)
23300	C  PRINTS LINES FOR SCRATCH.
23400	
23500	5557	WRITE(JOUT, 60)
23600		J(1,1)='    '
23700		WRITE(JOUT, 5),J
23800	CC	WRITE(JOUT, 60)
23900		IF(JOUT.EQ.5)PAUSE
24000	111	CONTINUE
24100		DO 1111 K=1,6
24200	1111	IC(K)=0
24300		LR=1
24400		JGRP=6
24500		KGRP=2
24600		MPRINT=2
24700				DO 1000 IGRP=1,4
24800		KK=0
24900		DO 17 K=1,12,JGRP
25000		  JJ=0
25100		  DO 117 L=1,JGRP
25200	117	  JJ=JJ+ISQ(K+L,2)
25300		KK=KK+1
25400	17	IC(KK)=JJ
25500		MM=0 
25600		MCNT=0
25700		DO 19 NN=1,2
25800		JQQ=4-NN
25900		DO 19 I=JQQ,13
26000		   DO 21 KK=1,KGRP
26100			DO 18 K=1,12,JGRP
26200			JJ=0
26300			  DO 118 L=1,JGRP
26400			  NI=I
26500			  NR=L+K
26600			  IF(NN.EQ.1)GO TO 118
26700			  NI=NR
26800			  NR=I
26900	118		  JJ=ISQ(NR,NI)+JJ
27000			LL=I
27100		        GO TO 18
27200		        WRITE(JOUT, 400),KK,JGRP,JJ,IGRP,KGRP,K
27300	18		IF(IC(KK).EQ.JJ)GO TO 21
27400		   GO TO 19
27500	21	   CONTINUE
27600		LI=LL
27700		LR=1
27800		IF(NN.EQ.1)GO TO 221
27900		LI=1
28000		LR=LL
28100	CC221	IF(MM.OR.NOPRIN)GO TO 55
28200	221	IF(MM)GO TO 55
28300		MPRINT=MPRINT+1
28400	C  COUNTS FOR STAFF PRINTOUT
28500		GO TO (11,22,33,44),IGRP
28600	11	WRITE(JOUT, 51)
28700		HEX=0
28800		GO TO 55
28900	22	WRITE(JOUT, 52)
29000		HEX=-10
29100		GO TO 55
29200	33	WRITE(JOUT, 53)
29300		HEX=-10
29400		GO TO 55
29500	44	WRITE(JOUT, 54)
29600		HEX=-10
29700	55	MM=-1
29800	CC	IF(NOPRIN)GO TO 19
29900		IF(HEX.EQ.5)WRITE(JOUT, 51)
30000		HEX=HEX+1
30100		MCNT=MCNT+1
30200		WRITE(JOUT, 50),J(LR,LI)
30300		IF(MCNT.LT.7)GO TO 19
30400		MCNT=0
30500		MM=0
30600	C  TO STAY IN 8 1/2" WIDTH ON PAPER
30700	19	CONTINUE
30800		JGRP=JGRP-1
30900		IF(IGRP.EQ.1)JGRP=4
31000	1000			KGRP=12/JGRP
31100		KREP=KREP-1
31200	CC	IF(NOPRIN)GO TO 188
31300		IF(JOUT.EQ.5)GO TO 662
31400		WRITE(JOUT, 60)
31500		L=5-MPRINT/2
31600		DO 5555 K=1,L
31700	5555	WRITE(JOUT, 5556)
31800		IF(KREP)CALL EXIT
31900		WRITE(JOUT, 500)
32000		GO TO 10
32100	5556	FORMAT(/5(1X,80('-')/)/)
32200	51	FORMAT(/' HEXADS ....R1',$)
32300	52	FORMAT(/' TETRADS ...R1',$)
32400	53	FORMAT(/' TRIADS ....R1',$)
32500	54	FORMAT(/' DYADS .....R1',$)
32600	5	FORMAT(1XA4,2(1X6A4)/2(/6(1XA4,2(1X6A4)/)))
32700	1	FORMAT (72A1)
32800	444	FORMAT (10A5)
32900	50	FORMAT('+  =  ',A3,$)
33000	60	FORMAT(1X10A5)
33100	66	FORMAT(1XA5,I2,3XI2)
33200	67	FORMAT(' GROUP SHORTENED TO ',I2)
33300	100	FORMAT(' TYPE 12 NOTES'/)
33400	500	FORMAT('1')
33500	400	FORMAT(6I)
33600		END